home *** CD-ROM | disk | FTP | other *** search
/ PC Open 101 / PC Open 101 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / $_1_ / URI / _query.pm < prev    next >
Encoding:
Perl POD Document  |  2004-02-03  |  1.8 KB  |  71 lines
  1. package URI::_query;
  2.  
  3. use strict;
  4. use URI ();
  5. use URI::Escape qw(uri_unescape);
  6.  
  7. sub query
  8. {
  9.     my $self = shift;
  10.     $$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;
  11.  
  12.     if (@_) {
  13.     my $q = shift;
  14.     $$self = $1;
  15.     if (defined $q) {
  16.         $q =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
  17.         $$self .= "?$q";
  18.     }
  19.     $$self .= $3;
  20.     }
  21.     $2;
  22. }
  23.  
  24. # Handle ...?foo=bar&bar=foo type of query
  25. sub query_form {
  26.     my $self = shift;
  27.     my $old = $self->query;
  28.     if (@_) {
  29.         # Try to set query string
  30.         my @query;
  31.         while (my($key,$vals) = splice(@_, 0, 2)) {
  32.             $key = '' unless defined $key;
  33.         $key =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g;
  34.         $key =~ s/ /+/g;
  35.         $vals = [ref($vals) ? @$vals : $vals];
  36.             for my $val (@$vals) {
  37.                 $val = '' unless defined $val;
  38.         $val =~ s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g;
  39.                 $val =~ s/ /+/g;
  40.                 push(@query, "$key=$val");
  41.             }
  42.         }
  43.         $self->query(join('&', @query));
  44.     }
  45.     return if !defined($old) || !length($old) || !defined(wantarray);
  46.     return unless $old =~ /=/; # not a form
  47.     map { s/\+/ /g; uri_unescape($_) }
  48.          map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/&/, $old);
  49. }
  50.  
  51. # Handle ...?dog+bones type of query
  52. sub query_keywords
  53. {
  54.     my $self = shift;
  55.     my $old = $self->query;
  56.     if (@_) {
  57.         # Try to set query string
  58.     my @copy = @_;
  59.     for (@copy) { s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/g; }
  60.     $self->query(join('+', @copy));
  61.     }
  62.     return if !defined($old) || !defined(wantarray);
  63.     return if $old =~ /=/;  # not keywords, but a form
  64.     map { uri_unescape($_) } split(/\+/, $old, -1);
  65. }
  66.  
  67. # Some URI::URL compatibility stuff
  68. *equery = \&query;
  69.  
  70. 1;
  71.